VERSION 5.00
Begin VB.Form PrintTestForm 
   Appearance      =   0  'Flat
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   0  'None
   ClientHeight    =   9000
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   12000
   LinkTopic       =   "Form1"
   ScaleHeight     =   9000
   ScaleWidth      =   12000
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   WindowState     =   2  'Maximized
   Begin VCT.SexPartnerDetailCtrl SexPartnerDetailCtrl1 
      Height          =   1155
      Left            =   180
      TabIndex        =   2
      Top             =   6120
      Visible         =   0   'False
      Width           =   11595
      _ExtentX        =   20452
      _ExtentY        =   2037
   End
   Begin VCT.ClientDemoCtrl ClientDemoCtrl1 
      Height          =   915
      Left            =   120
      TabIndex        =   0
      Top             =   180
      Visible         =   0   'False
      Width           =   11535
      _ExtentX        =   20346
      _ExtentY        =   1614
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   2000
      Left            =   10140
      Top             =   2040
   End
   Begin VCT.ClientPlanCtrl ClientPlanCtrl1 
      Height          =   1275
      Left            =   180
      TabIndex        =   3
      Top             =   7620
      Visible         =   0   'False
      Width           =   11475
      _ExtentX        =   20241
      _ExtentY        =   2249
   End
   Begin VCT.ClientSexHistCtrl ClientSexHistCtrl1 
      Height          =   975
      Left            =   120
      TabIndex        =   1
      Top             =   1140
      Visible         =   0   'False
      Width           =   11595
      _ExtentX        =   20452
      _ExtentY        =   1720
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "please wait ..."
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   24
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   6120
      TabIndex        =   5
      Top             =   4740
      Width           =   3795
   End
   Begin VB.Label Title 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Printing the completed VCT Form"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   24
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   1440
      TabIndex        =   4
      Top             =   3240
      Width           =   9195
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00C0E0FF&
      BorderWidth     =   3
      FillColor       =   &H00C0FFFF&
      FillStyle       =   0  'Solid
      Height          =   3555
      Left            =   1260
      Shape           =   4  'Rounded Rectangle
      Top             =   2520
      Width           =   9615
   End
End
Attribute VB_Name = "PrintTestForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub Form_Load()
   Timer1.Enabled = True
End Sub

Private Sub PrintSessionSummarySheet()

   Dim NewPtr As Printer

   For Each NewPtr In Printers
      If NewPtr.DeviceName = "LASER" Then
         Set Printer = NewPtr
   
         CurrPartner = 0 'need this to prevent the control from crashing
         
         'Get the record corresponding to the VisitID parameter
         CnUser.Open ConnectString
         Cmd.CommandText = "SELECT REGION, DISTRICT, SITE, VDATE, RETURNV, CLNTCODE, NEWCODE, SESSTYPE, COUPCODE, PARTCODE, COUPTYPE, COUNCODE, SEX, AGE, RESID, GROUPSES, EMPLOYED, OCCUPAT, EDUEXPE, MARSTAT, MARTYPE, MARHIST, KNOWUS1, KNOWUS2, KNOWUS3, KNOWUS4, KNOWUS5, KNOWUS6, KNOWUS7, KNOWUS8, KNOWUS98, KNOWUS99, REFERBY, REASHERE, VISITTYP" _
                        & " FROM   client" _
                        & " WHERE VISITID = " & VISITID
         Cmd.CommandType = adCmdText
         Cmd.ActiveConnection = CnUser
         RsUser.Open Cmd, , adOpenStatic
         
         REGION = RsUser(0)
         DISTRICT = RsUser(1)
         SITE = Mid(RsUser(2), 2, 2)
         VDATE = RsUser(3)
         RETURNV = RsUser(4)
         CLIENTCO = RsUser(5)
         NEWCODE = RsUser(6)
         SESSTYPE = RsUser(7)
         COUPCODE = RsUser(8)
         PARTCODE = RsUser(9)
         COUPTYPE = RsUser(10)
         COUNCODE = RsUser(11)
         Sex = RsUser(12)
         Age = RsUser(13)
         RESCLASS = RsUser(14)
         GROUPSES = RsUser(15)
         EMPLOYED = RsUser(16)
         OCCUPAT = RsUser(17)
         EDUEXPE = RsUser(18)
         MARSTAT = RsUser(19)
         MARTYPE = RsUser(20)
         MARHIST = RsUser(21)
         KNOWUS1 = RsUser(22)
         KNOWUS2 = RsUser(23)
         KNOWUS3 = RsUser(24)
         KNOWUS4 = RsUser(25)
         KNOWUS5 = RsUser(26)
         KNOWUS6 = RsUser(27)
         KNOWUS7 = RsUser(28)
         KNOWUS8 = RsUser(29)
         KNOWUS98 = RsUser(30)
         KNOWUS99 = RsUser(31)
         REFERBY = RsUser(32)
         REASHERE = RsUser(33)
         
         'Use this to determine if the rest of the record should be printer or not
         VISITTYP = RsUser(34)
            
         RsUser.Close
         CnUser.Close
         ClientDemoCtrl1.UpdateData
            
         'Get the client sexual history data
         CnUser.Open ConnectString
         Cmd.CommandText = "SELECT PRTESTED, TMONTH, TYEAR, PRTESITE, EVERHAD, LIFEPART, SMONTH, SYEAR, EVERAPED, PREG, TRANSFUS, STISYMPT, TBSYMPT, REFERRED" _
                        & " FROM   client" _
                        & " WHERE VISITID = " & VISITID
         Cmd.CommandType = adCmdText
         Cmd.ActiveConnection = CnUser
         RsUser.Open Cmd, , adOpenStatic
         
         PRTESTED = RsUser(0)
         TMONTH = RsUser(1)
         TYEAR = RsUser(2)
         PRTESITE = RsUser(3)
         EVERHAD = RsUser(4)
         LIFEPART = RsUser(5)
         SMONTH = RsUser(6)
         SYEAR = RsUser(7)
         EVERAPED = RsUser(8)
         PREG = RsUser(9)
         TRANSFUS = RsUser(10)
         STISYMPT = RsUser(11)
         TBSYMPT = RsUser(12)
         REFERRED = RsUser(13)
         
         RsUser.Close
         CnUser.Close
         ClientSexHistCtrl1.UpdateData
         
         'Get the history for the 4 most recent sexual partners
         CnUser.Open ConnectString
         Cmd.CommandText = "SELECT P1TYPE, P1NEW, P1STATUS, P1LTSTMO, P1LTSTYR, P1FPMETH, P1CONUSE, P1CONLST, P2TYPE, P2NEW, P2STATUS, P2LTSTMO, P2LTSTYR, P2FPMETH, P2CONUSE, P2CONLST, P3TYPE, P3NEW, P3STATUS, P3LTSTMO, P3LTSTYR, P3FPMETH, P3CONUSE, P3CONLST, P4TYPE, P4NEW, P4STATUS, P4LTSTMO, P4LTSTYR, P4FPMETH, P4CONUSE, P4CONLST" _
                        & " FROM   client" _
                        & " WHERE VISITID = " & VISITID
         Cmd.CommandType = adCmdText
         Cmd.ActiveConnection = CnUser
         RsUser.Open Cmd, , adOpenStatic
         
         PTYPE(0) = RsUser(0)
         PTYPE(1) = RsUser(8)
         PTYPE(2) = RsUser(16)
         PTYPE(3) = RsUser(24)
         PNEW(0) = RsUser(1)
         PNEW(1) = RsUser(9)
         PNEW(2) = RsUser(17)
         PNEW(3) = RsUser(25)
         PSTATUS(0) = RsUser(2)
         PSTATUS(1) = RsUser(10)
         PSTATUS(2) = RsUser(18)
         PSTATUS(3) = RsUser(26)
         PLTSTMO(0) = RsUser(3)
         PLTSTMO(1) = RsUser(11)
         PLTSTMO(2) = RsUser(19)
         PLTSTMO(3) = RsUser(27)
         PLTSTYR(0) = RsUser(4)
         PLTSTYR(1) = RsUser(12)
         PLTSTYR(2) = RsUser(20)
         PLTSTYR(3) = RsUser(28)
         PFPMETH(0) = RsUser(5)
         PFPMETH(1) = RsUser(13)
         PFPMETH(2) = RsUser(21)
         PFPMETH(3) = RsUser(29)
         PCONUSE(0) = RsUser(6)
         PCONUSE(1) = RsUser(14)
         PCONUSE(2) = RsUser(22)
         PCONUSE(3) = RsUser(30)
         PCONLST(0) = RsUser(7)
         PCONLST(1) = RsUser(15)
         PCONLST(2) = RsUser(23)
         PCONLST(3) = RsUser(31)
         
         RsUser.Close
         CnUser.Close
         SexPartnerDetailCtrl1.UpdateData
         
         
         'Get client plan details
         CnUser.Open ConnectString
         Cmd.CommandText = "SELECT HIV, DISCOR, RRPLAN0, RRPLAN1, RRPLAN2, RRPLAN3, RRPLAN4, RRPLAN5, RRPLAN6, RRPLAN7, RRPLAN8, RRPLAN9, RRPLAN10, RRPLAN11, RRPLAN99, REFTO0, REFTO1, REFTO2, REFTO3, REFTO4, REFTO5, REFTO6, REFTO7, REFTO8, REFTO98, REFTO99, COUNSELD, GAVERESU, COUNCOND" _
                        & " FROM   client" _
                        & " WHERE VISITID = " & VISITID
         Cmd.CommandType = adCmdText
         Cmd.ActiveConnection = CnUser
         RsUser.Open Cmd, , adOpenStatic
         
         HIV = RsUser(0)
         DISCOR = RsUser(1)
         RRPLAN0 = RsUser(2)
         RRPLAN1 = RsUser(3)
         RRPLAN2 = RsUser(4)
         RRPLAN3 = RsUser(5)
         RRPLAN4 = RsUser(6)
         RRPLAN5 = RsUser(7)
         RRPLAN6 = RsUser(8)
         RRPLAN7 = RsUser(9)
         RRPLAN8 = RsUser(10)
         RRPLAN9 = RsUser(11)
         RRPLAN10 = RsUser(12)
         RRPLAN11 = RsUser(13)
         RRPLAN99 = RsUser(14)
         REFTO0 = RsUser(15)
         REFTO1 = RsUser(16)
         REFTO2 = RsUser(17)
         REFTO3 = RsUser(18)
         REFTO4 = RsUser(19)
         REFTO5 = RsUser(20)
         REFTO6 = RsUser(21)
         REFTO7 = RsUser(22)
         REFTO8 = RsUser(23)
         REFT98 = RsUser(24)
         REFTO99 = RsUser(25)
         COUNSELD = RsUser(26)
         GAVERESU = RsUser(27)
         COUNCOND = RsUser(28)
         
         RsUser.Close
         CnUser.Close
         
         'Get the extra variables for Lighthouse
         If ORGANIZATION = "LIGHTHOUSE" Then
            CnUser.Open ConnectString
            Cmd.CommandText = "SELECT REFTO9, REFTO10, REFTO11, RRPLAN12" _
                           & " FROM   client" _
                           & " WHERE VISITID = " & VISITID
            Cmd.CommandType = adCmdText
            Cmd.ActiveConnection = CnUser
            RsUser.Open Cmd, , adOpenStatic
            REFTO9 = RsUser(0)
            REFTO10 = RsUser(1)
            REFTO11 = RsUser(2)
            RRPLAN12 = RsUser(3)
            RsUser.Close
            CnUser.Close
         Else
            REFTO9 = "0"
            REFTO10 = "0"
            REFTO11 = "0"
            RRPLAN12 = "0"
         End If
         
         ClientPlanCtrl1.UpdateData
         
         Printer.FontName = "Arial Narrow"
         Printer.PaperSize = vbPRPSA4   'Set printer for A4 paper
         Printer.FontBold = False
         Printer.FontItalic = False
         Printer.FontUnderline = False
         Printer.Orientation = 1
         
         Printer.FontSize = 14
         If ORGANIZATION = "MACRO" Then
            Printer.CurrentX = 1750
            Printer.CurrentY = 300
            Printer.Print "MALAWI AIDS COUNSELLING AND RESOURCE ORGANISATION (MACRO)"
         Else
            If ORGANIZATION = "LIGHTHOUSE" Then
               Printer.CurrentX = 4200
               Printer.CurrentY = 300
               Printer.Print "LIGHTHOUSE VCT CENTRE"
            End If
         End If
         Printer.CurrentX = 3700
         Printer.FontSize = 12
         Printer.Print "HIV COUNSELLING AND TESTING RECORD"
         
         Printer.CurrentY = 1400
         Printer.CurrentX = 600
         Printer.Print "Region Code:   " & REGION
         Printer.CurrentX = 600
         Printer.Print "District Code:   " & DISTRICT
         Printer.CurrentX = 600
         Printer.Print "Site Code:   " & SITE
         Printer.CurrentX = 600
         Printer.Print "Visit Date:   " & VDATE
         Printer.CurrentX = 600
         If RETURNV = "" Then
            Printer.Print "Return Visit: "
         Else
            If RETURNV = "0" Then
               Printer.Print "Return Visit:   No"
            Else
               If RETURNV = "1" Then
                  Printer.Print "Return Visit:   Yes"
               Else
                  Printer.Print "Return Visit:   ERROR"
               End If
            End If
         End If
            
         Printer.CurrentX = 600
         Printer.Print "Client Code:   " & CLIENTCO
         Printer.CurrentX = 600
         If NEWCODE = "" Then
            Printer.Print "New Client Code: "
         Else
            If NEWCODE = "0" Then
               Printer.Print "New Client Code:   No"
            Else
               If NEWCODE = "1" Then
                  Printer.Print "New Client Code:   Yes"
               Else
                  Printer.Print "New Client Code:   ERROR"
               End If
            End If
         End If
            
         Printer.CurrentX = 600
         If SESSTYPE = "" Then
            Printer.Print "Session Type: "
         Else
            If SESSTYPE = "01" Then
               Printer.Print "Session Type:   Individual"
            Else
               If SESSTYPE = "02" Then
                  Printer.Print "Session Type:   Couple"
               Else
                  If SESSTYPE = "99" Then
                     Printer.Print "Session Type:   Other"
                  Else
                     Printer.Print "Session Type:   ERROR"
                  End If
               End If
            End If
         End If
      
         Printer.CurrentX = 600
         Printer.Print "Couple Code:   " & COUPCODE
         Printer.CurrentX = 600
         Printer.Print "Partner Code:   " & PARTCODE
         
         ClientDemoCtrl1.PrintClientInfo
         Printer.Print
         ClientSexHistCtrl1.PrintClientInfo
         SexPartnerDetailCtrl1.PrintClientInfo
         Printer.Print
         Printer.Print
         
         If VISITTYP = "2" Then 'Counseled only
            Printer.CurrentX = 600
            Printer.Print "*** COUNSELED ONLY ***"
         End If
         
         If VISITTYP = "1" Then
            
            Printer.CurrentX = 600
            If HIV = "" Then
               Printer.Print "HIV: "
            Else
               If HIV = "00" Then
                  Printer.Print "HIV:   Negative"
               Else
                  If HIV = "01" Then
                     Printer.Print "HIV:   Positive"
                  Else
                     If HIV = "97" Then
                        Printer.Print "HIV:   Inconclusive"
                     Else
                        If HIV = "98" Then
                           Printer.Print "HIV:   N/A"
                        Else
                           Printer.Print "HIV:   ERROR"
                        End If
                     End If
                  End If
               End If
            End If
            
         End If
            
         Printer.Print
         ClientPlanCtrl1.PrintClientInfo
         
         ReturnVal = PrintRect(400, 1200, 10700, 14600)
         Printer.Line (400, 5900)-Step(10700, 0)
         Printer.Line (400, 9900)-Step(10700, 0)
         Printer.Line (400, 10500)-Step(10700, 0)
         Printer.Line (400, 12600)-Step(10700, 0)
         
         Printer.EndDoc
         
      End If
   Next NewPtr
   
End Sub

Private Sub Timer1_Timer()
   PrintSessionSummarySheet
   VCTStageForm.Show
   Unload Me
End Sub
